TPUG - Toronto PET Users Group/TPUG Users Group CD/TPUG Users Group CD.iso/COMAL/A-COMAL Series/(k)aaj.d64/src.text-1.02

Text File | 2007-02-28 | 8KB | 483 lines

;
;--------------------------------;
;                                ;
; TEXT - A COMAL PACKAGE         ;
;                                ;
; REV. 1.02                      ;
;                                ;
; DUTCH COMAL USERS GROUP        ;
;                                ;
; LAST CHANGE 860707             ;
;                                ;
;--------------------------------;
;
DEFPAG = %01000110
DUMMY  = $CA2F
PROC   = 112
ENDPRC = 126
FUNC   = 227
ENDFNC = 126
PSHINT = $C9CE
EXCGST = $C9E0
REAL   = 0
INT    = 1
STR    = 2
REF    = 117
POINT  = $FB
FNDPAR = $C896
COPY1  = $45
COPY2  = $47
COPY3  = $49
COPYDN = $C8A2
RUNERR = $C9FB
LIBPT  = $C7EF
LIBLO  = $C7F0
LIBHI  = $C7FA
LIBPAG = $C804
;
*      = $8009
;
       .BYTE DEFPAG
EINDE  .WORD END
       .WORD DUMMY
       .BYTE 4,'TEXT'
       .WORD PROCS
       .WORD RESET
       .BYTE 0
;
PROCS  .BYTE 7,'REWRITE'
       .WORD HEMPTY
       .BYTE 7,'WRITELN'
       .WORD HPUT
       .BYTE 6,'READLN'
       .WORD HGET
       .BYTE 5,'RESET'
       .WORD HRES
       .BYTE 3,'EOT'
       .WORD HEOT
       .BYTE 9,'BYTESFREE'
       .WORD HFREE
;
 .BYTE  12,'VERSION''TEXT'
 .WORD  HVERST
       .BYTE 0
;
HEMPTY .BYTE PROC
       .WORD EMPTY
       .BYTE 0
       .BYTE ENDPRC
;
HPUT   .BYTE PROC
       .WORD PUT
       .BYTE 1
       .BYTE STR+REF
       .BYTE ENDPRC
;
HGET   .BYTE PROC
       .WORD GET
       .BYTE 1
       .BYTE STR+REF
       .BYTE ENDPRC
;
HRES   .BYTE PROC
       .WORD RESET
       .BYTE 0
       .BYTE ENDPRC
;
HEOT   .BYTE FUNC+REAL
       .WORD EOT
       .BYTE 0
       .BYTE ENDFNC
;
HFREE  .BYTE FUNC+REAL
       .WORD FREE
       .BYTE 0
       .BYTE ENDFNC
;
;--------------------------------;
; PROC REWRITE CLOSED            ;
;--------------------------------;
;
EMPTY  LDA #<END
       LDY #>END
       STA EINDE
       STY EINDE+1
;
;--------------------------------;
; PROC RESET CLOSED              ;
;--------------------------------;
;
RESET  LDA #<END
       LDY #>END
       STA SUBPNT
       STY SUBPNT+1
       RTS
;
;--------------------------------;
; FUNC EOT CLOSED                ;
;--------------------------------;
;
EOT    JSR TEOF
       LDA #0
       ROL A
       TAX
       LDA #0
       JMP PSHINT
;
;--------------------------------;
; FUNC BYTESFREE CLOSED          ;
;--------------------------------;
;
FREE   JSR MAX
       LDA MAXADD
       CLC
       SBC EINDE
       TAX
       LDA MAXADD+1
       SBC EINDE+1
       JMP PSHINT
;
;--------------------------------;
; PROC WRITELN(STR) CLOSED       ;
;--------------------------------;
;
PUT    LDA #1
       JSR FNDPAR
;
; POINTER ON CURRENT LENGTH:
;              = COPY FROM!
;
       LDA COPY1
       CLC
       ADC #<2
       STA COPY1
       LDA COPY1+1
       ADC #>2
       STA COPY1+1
;
; COPY TO = END OF PACKAGE:
;
       LDA EINDE
       LDY EINDE+1
       STA COPY2
       STY COPY2+1
;
; COPY LENGTH = CURRENT LENGTH:
;
       LDY #1
SETUP  LDA (COPY1),Y
       STA COPY3,Y
       DEY
       BPL SETUP
;
; COPY3:+2 (LENGTH MUST BE SAVED):
;
       JSR LEN
;
; LOOK FOR BUFFER OVERFLOW
;
       JSR MAX
;
       LDA COPY3+1
       CLC
       ADC EINDE
       TAX
       LDA COPY3
       ADC EINDE+1
       TAY
       TXA
       SEC
       SBC MAXADD
       TYA
       SBC MAXADD+1
       BCS OUT
;
; ELSE, SET NEW END:
;
       STX EINDE
       STY EINDE+1
;
; AND COPY STRING IN BUFFER
;
       JMP COPYDN
;
;--------------------------------;
; ENTRIES FOR ERROR MESSAGES:    ;
; - END OF FILE                  ;
; - OUT OF MEMORY                ;
;--------------------------------;
;
EOF    LDX #201
       .BYTE $2C
OUT    LDX #52
       JMP RUNERR
;
;--------------------------------;
; TEST FOR EOT, CARRY=1 IF SO    ;
;--------------------------------;
;
TEOF   LDA SUBPNT
       SEC
       SBC EINDE
       LDA SUBPNT+1
       SBC EINDE+1
       RTS
;
;--------------------------------;
; PROC READLN(STR) CLOSED        ;
;--------------------------------;
;
; TEST FOR END OF BUFFER
;
GET    JSR TEOF
       BCS EOF
;
       LDA #1
       JSR FNDPAR
;
; COPY TO = COPY1 + 2:
;
       LDA COPY1
       CLC
       ADC #<2
       STA COPY2
       LDA COPY1+1
       ADC #>2
       STA COPY2+1
;
; COPY READ POINTER TO ZEROPAGE:
;
       LDA SUBPNT
       LDY SUBPNT+1
       STA POINT
       STY POINT+1
;
; LOOK IF THE STRING IN BUFFER
; WILL FIT IN THE STRING:
;
       LDY #1
       LDA (COPY1),Y
       SEC
       SBC (POINT),Y
       DEY
       LDA (COPY1),Y
       SBC (POINT),Y
       BCC NOROOM
;
;-COPY WHOLE STRING--------------;
;
; COPY FROM = READ POINTER
;
       LDA POINT
       LDY POINT+1
       STA COPY1
       STY COPY1+1
;
; COPY LENGTH = BUF. STRING LENGTH
;
       LDY #1
SETUP1 LDA (POINT),Y
       STA COPY3,Y
       DEY
       BPL SETUP1
;
; COPY3:+2 (2 BYTES FOR LENGTH):
;
       JSR LEN
;
; MOVE READ POINTER OVER STRING:
;
       LDA POINT
       CLC
       ADC COPY3+1
       STA SUBPNT
       LDA POINT+1
       ADC COPY3
       STA SUBPNT+1
;
; AND COPY STRING FROM BUFFER
;
       JMP COPY
;
;-COPY FIRST PART OF STRING------;
;
; COPY LENGTH = STRING LENGTH:
;
NOROOM LDA (COPY1),Y
       STA COPY3
       PHA
       INY
       LDA (COPY1),Y
       STA COPY3+1
       PHA
;
; COPY TO = READ POINTER
;
       LDA POINT
       LDY POINT+1
       STA COPY1
       STY COPY1+1
;
; COPY3:+2 (2 BYTES FOR LENGTH)
;
       JSR LEN
;
; MOVE READ POINTER OVER STRING
;
       LDY #1
       LDA (POINT),Y
       CLC
       ADC POINT
       TAX
       DEY
       LDA (POINT),Y
       ADC POINT+1
       TAY
       TXA
       CLC
       ADC #<2
       STA SUBPNT
       TYA
       ADC #>2
       STA SUBPNT+1
;
; SET CURRENT STRING LENGTH
;
       LDY #1
       PLA
       STA (COPY1),Y
       DEY
       PLA
       STA (COPY1),Y
;
; AND COPY STRING
;
;--------------------------------;
; SUBROUTINE COPY FROM BENEATH   ;
; ROM. COMAL SUBROUTINES DOESN'T ;
;--------------------------------;
;
COPY   LDX COPY3
       LDA COPY3+1
       TAY
       BEQ L001
       EOR #255
       TAY
       INY
       CLC
       LDA COPY1
       ADC COPY3+1
       STA COPY1
       BCS L002
       DEC COPY1+1
L002   CLC
       LDA COPY2
       ADC COPY3+1
       STA COPY2
       BCS L003
       DEC COPY2+1
L003   LDA (COPY1),Y
       STA (COPY2),Y
       INY
       BNE L003
       INC COPY1+1
       INC COPY2+1
L001   DEX
       BPL L003
       RTS
;
;--------------------------------;
; SUBROUTINE ADD 2 TO COPY3      ;
;--------------------------------;
;
LEN    LDA COPY3+1
       CLC
       ADC #<2
       STA COPY3+1
       LDA COPY3
       ADC #>2
       STA COPY3
       RTS
;
;--------------------------------;
; SUBROUTINE CALCULATE MAX'ADD   ;
;--------------------------------;
;
MAX    LDA #<$C000
       LDY #>$C000
       STA MAXADD
       STY MAXADD+1
;
       LDX LIBPT
MAXLP  DEX
       BPL MXSRCH
       RTS
;
MXSRCH LDA LIBPAG,X
       AND #%11000111
       CMP #%01000100
       BEQ MAXOK
       CMP #%01000101
       BEQ MAXOK
       CMP #%01000110
       BNE MAXLP
;
MAXOK  LDA LIBLO,X
       SEC
       SBC MAXADD
       LDA LIBHI,X
       SBC MAXADD+1
       BCS MAXLP
;
       LDA LIBLO,X
       SEC
       SBC #<END
       LDA LIBHI,X
       SBC #>END
       BCC MAXLP
;
       LDA LIBLO,X
       LDY LIBHI,X
       STA MAXADD
       STY MAXADD+1
       BNE MAXLP
;
;--------------------------------;
; VERSION NUMBER                 ;
;--------------------------------;
;
HVERST .BYTE FUNC+STR
  .WORD VERSTR
  .BYTE 0
  .BYTE ENDFNC
;
VERSTR LDA #VERST3-VERST2+2
 JSR EXCGST
 LDY #0
VERST1 LDA VERST2,Y
 STA (COPY2),Y
 INY
 CPY #VERST3-VERST2
 BNE VERST1
 LDA #0
       STA (COPY2),Y
 LDA #VERST3-VERST2
 INY
 STA (COPY2),Y
 RTS
;
VERST2 .BYTE ' 1.02 TEXT PACKAGE'
 .BYTE ' BY MARCEL BOKHORST'
VERST3
;
;--------------------------------;
; SOME VARIABLES                 ;
;--------------------------------;
;
SUBPNT .WORD 0
MAXADD .WORD 0
;
; AND FINALLY THE
;
END    .END